Celestin Apprentice 2/Apprentice-Release2.iso/Source Code/Peter Lewis/PNL Libraries/MyMacBinary.p

Text File | 1994-11-06 | 4.0 KB | 148 lines | [TEXT/PJMM]

unit MyMacBinary;

interface

    uses
        CalcCRC;

    const
        macbin_folder_ftype = 'fold';
        macbin_folder_creator_start = -1; { Should be OSType(-1), damn TP! }
        macbin_folder_creator_end = -2;

    type
        MBpacket = packed array[1..128] of byte;

    type
        MBIIStartHeader = packed record
                name: str63;
                ftype: OSType;
                fcreator: OSType;
                flags_high: byte;
                zero1: byte;
                flocation: Point;
                windowID: integer; {? - ignore }
                protected: byte; { low order bit - ignore}
                zero2: byte;
                dlen: longInt;
                rlen: longInt;
                create_date: longInt;
                mod_date: longInt;
                clen: integer;
                flags_low: byte;
            end;
        MBIIHeader = packed record
                version: signedByte;
                MBIIStart: signedByte;
                space: packed array[2..115] of byte;
                total_unpack_len: longInt;{ignore}
                second_header_len: integer;{ignore}
                versionII: byte;
                minversionII: byte;
                crc: integer;
                processorID: integer; {ignore}
            end;
        packet_type = (PT_None, PT_File, PT_StartBlock, PT_EndBlock);

    function ValidateMBHeader (var header: MBIIHeader; handle2plus: boolean): packet_type;
    procedure CatInfo2MBHeader (var pb: CInfoPBRec; var header: MBIIHeader; dtdbr: integer; var comment: str255);

implementation

    uses
        MyMemory, MyDesktopDB;

    function ValidateMBHeader (var header: MBIIHeader; handle2plus: boolean): packet_type;
        var
            ocrc, i: integer;
            typ: packet_type;
            start: MBIIStartHeader;
    begin
        BlockMove(@header.MBIIStart, @start, SizeOf(start));
        typ := PT_None;
        with header do begin
            if (version <= ord(handle2plus)) & (MBpacket(header)[75] = 0) then begin
                ocrc := 0;
                for i := 1 to 124 do begin
                    CalcMBCRC(ocrc, MBpacket(header)[i]);
                end;
                if ocrc = MBIIHeader(header).crc then begin
                    if (version = 1) & (start.ftype = macbin_folder_ftype) & ((start.fcreator = OSType(macbin_folder_creator_start)) or (start.fcreator = OSType(macbin_folder_creator_end))) then begin
                        if start.fcreator = OSType(macbin_folder_creator_start) then
                            typ := PT_StartBlock
                        else
                            typ := PT_EndBlock;
                    end
                    else begin
                        typ := PT_File;
                    end;
                end
                else begin { Assume its a valid MacBinary I file }
                    if (version = 0) then begin
                        MBpacket(header)[101] := 0; { Zero out the flags low_byte }
                        total_unpack_len := 0;
                        second_header_len := 0;
                        versionII := 129;
                        minversionII := 129;
                        crc := 0;
                        processorID := 0;
                        typ := PT_File;
                    end;
                end;
            end;
        end;
        if typ in [PT_StartBlock, PT_File] then begin
            if (MBpacket(header)[2] < 1) | (MBpacket(header)[2] > 31) then begin
                typ := PT_None;
            end;
        end;
        ValidateMBHeader := typ;
    end;

    procedure CatInfo2MBHeader (var pb: CInfoPBRec; var header: MBIIHeader; dtdbr: integer; var comment: str255);
        var
            start: MBIIStartHeader;
            fs: FSSpec;
            folder: boolean;
            ocrc, i: integer;
    begin
        folder := BAND(pb.ioFlAttrib, $10) <> 0;
        MFillLong(@header, SizeOf(header), 0);
        MFill(@start, SizeOf(start), 0);
        header.version := ord(folder);
        header.versionII := 129 + ord(folder);
        header.minversionII := 129 + ord(folder);
        start.name := pb.ioNamePtr^;
        start.flags_high := BAND(BSR(pb.ioFlFndrInfo.fdFlags, 8), $FF);
        start.flags_low := BAND(pb.ioFlFndrInfo.fdFlags, $FF);
        start.flocation := pb.ioFlFndrInfo.fdLocation;
        start.windowID := pb.ioFlFndrInfo.fdFldr;
        start.create_date := pb.ioFlCrDat;
        start.mod_date := pb.ioFlMdDat;

        if folder then begin
            start.ftype := macbin_folder_ftype;
            start.fcreator := OSType(macbin_folder_creator_start);
            start.dlen := 0;
            start.rlen := 0;
        end
        else begin
            start.ftype := pb.ioFlFndrInfo.fdType;
            start.fcreator := pb.ioFlFndrInfo.fdCreator;
            start.dlen := pb.ioFlLgLen;
            start.rlen := pb.ioFlRLgLen;
        end;

        fs.vRefNum := pb.ioVRefNum;
        fs.parID := pb.ioFlParID;
        fs.name := pb.ioNamePtr^;
        GetDTDBComment(dtdbr, fs, comment);
        start.clen := length(comment);
        BlockMove(@start, @header.MBIIStart, SizeOf(start));
        ocrc := 0;
        for i := 1 to 124 do
            CalcMBCRC(ocrc, MBPacket(header)[i]);
        header.crc := ocrc;
    end;

end.